
          .md # Εξέλιξη κατανομής πολιτικού φάσματος

Εξέλιξη κατανομής πολιτικού φάσματος


          .md ## Διατύπωση προβλήματος

Ας υποθέσουμε ότι έχουμε έναν πληθυσμό, με τα μέλη του να έχουν μια πολιτική τοποθέτηση, η οποία να καθορίζεται από $n$ παραμέτρους. Συνεπώς, μπορούμε να θεωρήσουμε ότι η πολιτική τοποθέτηση κάθε ατόμου είναι ένα σημείο του $\mathbb{R}^n$. Η πληθυσμιακή πυκνότητα στην πολιτική θέση $\boldsymbol{x}\in\mathbb{R}^n$ ($n=1,2,3,\dots$) τη χρονική στιγμή $t$ δίνεται από τη συνάρτηση $u(\boldsymbol{x},t)$. Θεωρούμε επίσης ότι στη θέση $\boldsymbol{x}$ τη χρονική στιγμή $t$ υπάρχει ροή πληθυσμού ίση με $\boldsymbol{\phi}(\boldsymbol{x},t)$. Τέλος, ας υποθέσουμε ότι ο ρυθμός γεννήσεων  είναι πυκνοεξαρτόμενος και ίσος με $r(u)$.

Ας εξετάσουμε τώρα μια περιοχή $A$ του πολιτικού φάσματος. Εκεί η πληθυσμιακή πυκνότητα τη χρονική στιγμή $t$ θα είναι:

$$
\int_Vu(\boldsymbol{x},t)d V,
$$

όπου $d V$ το στοιχείο του χώρου $A$. Επομένως ο ρυθμός μεταβολής των ατόμων της περιοχής αυτής θα είναι:

$$
\dfrac{d}{d t}\int_A u(\boldsymbol{x},t)d V.
$$

Όμως ο ρυθμός μεταβολής του πληθυσμού της περιοχής $A$ είναι:

- ο ρυθμός των ατόμων που ρέουν προς το εσωτερικό του $A$:
	
$$
  -\int_{\partial A}\boldsymbol{\phi}(\boldsymbol{x},t)\boldsymbol{n}(\boldsymbol{x},t)d S,
$$
	
όπου $\boldsymbol{n}(\boldsymbol{x},t)$ το κάθετο διάνυσμα στην επιφάνεια $\partial A$ στη θέση $\boldsymbol{x}\in\partial A$ και $d S$ το στοιχείο της επιφάνειας $\partial A$,
	
- συν τον ρυθμό παραγωγής νέων ατόμων σε όλη την περιοχή $A$:
	
$$
\int_Ar\left(u(\boldsymbol{x},t)\right)d V.
$$

Όμως από το θεώρημα της απόκλισης έχουμε ότι:

$$
-\int_{\partial V}\boldsymbol{\phi}(\boldsymbol{x},t)\boldsymbol{n}(\boldsymbol{x},t)d S=-\int_{ V}\nabla\cdot\boldsymbol{\phi}(\boldsymbol{x},t)d \boldsymbol{x}.
$$

Στο σημείο αυτό να σημειώσουμε ότι από εδώ και στο εξής το ανάδελτα θα θεωρούμε ότι αφορά τις μεταβλητές του χώρου. Ο χρόνος θα είναι κάτι σαν παράμετρος.

Έτσι, δεδομένου ότι:

$$
\dfrac{d}{d t}\int_A u(\boldsymbol{x},t)d V=\int_A u_t(\boldsymbol{x},t)d V,
$$

διαπιστώνουμε ότι:

$$
\int_A\left( u_t+\nabla\cdot\boldsymbol{\phi}-r\left( u\right) \right) d \boldsymbol{x} =0.
$$

Καθόσον τα παραπάνω θέλουμε να ισχύουν για κάθε περιοχή $Α$, καταλήγουμε στη μερική διαφορική εξίσωση:

$$
u_t+\nabla\cdot\boldsymbol{\phi}=r(u).
$$

Μέχρι τώρα έχουμε δύο άγνωστες συναρτήσεις, την $u$ και τη $\phi$. Ας δούμε μήπως αυτές σχετίζονται, ώστε να έχουμε να ψάξουμε μόνο μία. Μια εύλογη υπόθεση θα ήταν να υπάρχει συγκέντρωση πληθυσμού στα γειτονικά σημεία με τη μεγαλύτερη συγκέντρωση, δηλαδή ότι ο κάθε ένας που φέρει μια συγκεκριμένη πολιτική άποψη έχει μια τάση να μετατοπιστεί πολιτικά προς την δημοφιλέστερη κοντινή σε αυτόν άποψη. Με άλλα λόγια, σε κάθε σημείο $\boldsymbol{x}\in\mathbb{R}^n$  ο πληθυσμός τείνει να μετατοπιστεί προς το γειτονικό σημείο ($ \boldsymbol{x}+d\boldsymbol{x} $) με τη μεγαλύτερη δυνατή πυκνότητα.  Η εν λόγω κατεύθυνση της μέγιστης αύξησης πυκνότητας δεν είναι άλλη από αυτήν του $\nabla u$. Αφού, λοιπόν, ο πληθυσμός ρέει προς την κατεύθυνση του $\nabla u$, σημαίνει ότι $\boldsymbol{\phi}\uparrow\uparrow \nabla u$, ήτοι ότι υπάρχει $kD>0$ τέτοιο, ώστε:

$$
\boldsymbol{\phi}= k \nabla u,
$$

το οποίο είναι μια παραλλαγή του νόμου του Fick για τις $n$ διαστάσεις.

Καταλήγουμε, λοιπόν, στη μερική διαφορική εξίσωση:

$$
u_t+k\nabla^2 u =r(u),
$$

όπου $\nabla^2$ η Λαπλασιανή:

$$
\nabla^2=\sum_{j=1}^{n}\dfrac{\partial^2}{\partial x_j^2}.
$$

Θα μπορούσαμε να πούμε ότι η παραπάνω Μ.Δ.Ε. είναι μια παραλλαγή της πολυδιάστατης εξίσωσης Fisher.

Το μονοδιάστατο ανάλογο της παραπάνω εξίσωσης (στην περίπτωση που η πολιτική τοποθέτηση καθορίζεται μονοπαρεμετρικά, π.χ. θέση στο διάστημα αριστερά-δεξιά) είναι:

$$
u_t+ku_{xx}=r(u)
$$

Διατύπωση προβλήματος

Ας υποθέσουμε ότι έχουμε έναν πληθυσμό, με τα μέλη του να έχουν μια πολιτική τοποθέτηση, η οποία να καθορίζεται από $n$ παραμέτρους. Συνεπώς, μπορούμε να θεωρήσουμε ότι η πολιτική τοποθέτηση κάθε ατόμου είναι ένα σημείο του $\mathbb{R}^n$. Η πληθυσμιακή πυκνότητα στην πολιτική θέση $\boldsymbol{x}\in\mathbb{R}^n$ ($n=1,2,3,\dots$) τη χρονική στιγμή $t$ δίνεται από τη συνάρτηση $u(\boldsymbol{x},t)$. Θεωρούμε επίσης ότι στη θέση $\boldsymbol{x}$ τη χρονική στιγμή $t$ υπάρχει ροή πληθυσμού ίση με $\boldsymbol{\phi}(\boldsymbol{x},t)$. Τέλος, ας υποθέσουμε ότι ο ρυθμός γεννήσεων είναι πυκνοεξαρτόμενος και ίσος με $r(u)$. Ας εξετάσουμε τώρα μια περιοχή $A$ του πολιτικού φάσματος. Εκεί η πληθυσμιακή πυκνότητα τη χρονική στιγμή $t$ θα είναι: $$ \int_Vu(\boldsymbol{x},t)d V, $$ όπου $d V$ το στοιχείο του χώρου $A$. Επομένως ο ρυθμός μεταβολής των ατόμων της περιοχής αυτής θα είναι: $$ \dfrac{d}{d t}\int_A u(\boldsymbol{x},t)d V. $$ Όμως ο ρυθμός μεταβολής του πληθυσμού της περιοχής $A$ είναι: - ο ρυθμός των ατόμων που ρέουν προς το εσωτερικό του $A$: $$ -\int_{\partial A}\boldsymbol{\phi}(\boldsymbol{x},t)\boldsymbol{n}(\boldsymbol{x},t)d S, $$ όπου $\boldsymbol{n}(\boldsymbol{x},t)$ το κάθετο διάνυσμα στην επιφάνεια $\partial A$ στη θέση $\boldsymbol{x}\in\partial A$ και $d S$ το στοιχείο της επιφάνειας $\partial A$, - συν τον ρυθμό παραγωγής νέων ατόμων σε όλη την περιοχή $A$: $$ \int_Ar\left(u(\boldsymbol{x},t)\right)d V. $$ Όμως από το θεώρημα της απόκλισης έχουμε ότι: $$ -\int_{\partial V}\boldsymbol{\phi}(\boldsymbol{x},t)\boldsymbol{n}(\boldsymbol{x},t)d S=-\int_{ V}\nabla\cdot\boldsymbol{\phi}(\boldsymbol{x},t)d \boldsymbol{x}. $$ Στο σημείο αυτό να σημειώσουμε ότι από εδώ και στο εξής το ανάδελτα θα θεωρούμε ότι αφορά τις μεταβλητές του χώρου. Ο χρόνος θα είναι κάτι σαν παράμετρος. Έτσι, δεδομένου ότι: $$ \dfrac{d}{d t}\int_A u(\boldsymbol{x},t)d V=\int_A u_t(\boldsymbol{x},t)d V, $$ διαπιστώνουμε ότι: $$ \int_A\left( u_t+\nabla\cdot\boldsymbol{\phi}-r\left( u\right) \right) d \boldsymbol{x} =0. $$ Καθόσον τα παραπάνω θέλουμε να ισχύουν για κάθε περιοχή $Α$, καταλήγουμε στη μερική διαφορική εξίσωση: $$ u_t+\nabla\cdot\boldsymbol{\phi}=r(u). $$ Μέχρι τώρα έχουμε δύο άγνωστες συναρτήσεις, την $u$ και τη $\phi$. Ας δούμε μήπως αυτές σχετίζονται, ώστε να έχουμε να ψάξουμε μόνο μία. Μια εύλογη υπόθεση θα ήταν να υπάρχει συγκέντρωση πληθυσμού στα γειτονικά σημεία με τη μεγαλύτερη συγκέντρωση, δηλαδή ότι ο κάθε ένας που φέρει μια συγκεκριμένη πολιτική άποψη έχει μια τάση να μετατοπιστεί πολιτικά προς την δημοφιλέστερη κοντινή σε αυτόν άποψη. Με άλλα λόγια, σε κάθε σημείο $\boldsymbol{x}\in\mathbb{R}^n$ ο πληθυσμός τείνει να μετατοπιστεί προς το γειτονικό σημείο ($ \boldsymbol{x}+d\boldsymbol{x} $) με τη μεγαλύτερη δυνατή πυκνότητα. Η εν λόγω κατεύθυνση της μέγιστης αύξησης πυκνότητας δεν είναι άλλη από αυτήν του $\nabla u$. Αφού, λοιπόν, ο πληθυσμός ρέει προς την κατεύθυνση του $\nabla u$, σημαίνει ότι $\boldsymbol{\phi}\uparrow\uparrow \nabla u$, ήτοι ότι υπάρχει $kD>0$ τέτοιο, ώστε: $$ \boldsymbol{\phi}= k \nabla u, $$ το οποίο είναι μια παραλλαγή του νόμου του Fick για τις $n$ διαστάσεις. Καταλήγουμε, λοιπόν, στη μερική διαφορική εξίσωση: $$ u_t+k\nabla^2 u =r(u), $$ όπου $\nabla^2$ η Λαπλασιανή: $$ \nabla^2=\sum_{j=1}^{n}\dfrac{\partial^2}{\partial x_j^2}. $$ Θα μπορούσαμε να πούμε ότι η παραπάνω Μ.Δ.Ε. είναι μια παραλλαγή της πολυδιάστατης εξίσωσης Fisher. Το μονοδιάστατο ανάλογο της παραπάνω εξίσωσης (στην περίπτωση που η πολιτική τοποθέτηση καθορίζεται μονοπαρεμετρικά, π.χ. θέση στο διάστημα αριστερά-δεξιά) είναι: $$ u_t+ku_{xx}=r(u) $$


                                                                .md ## Πειραματισμός με διάφορες κατανομές

Στις παρακάτω ενότητες θα εξετάσουμε πώς εξελίσσονται διάφοροι πληθυσμοί, θεωρώντας για λόγους απλούστευσης την πολιτική τοποθέτηση να μην είναι πολυδιάστατη, αλλά να μπορεί να προσδιοριστεί από την τιμή ενός αριθμού πάνω στην πραγματική ευθεία.

Πειραματισμός με διάφορες κατανομές

Στις παρακάτω ενότητες θα εξετάσουμε πώς εξελίσσονται διάφοροι πληθυσμοί, θεωρώντας για λόγους απλούστευσης την πολιτική τοποθέτηση να μην είναι πολυδιάστατη, αλλά να μπορεί να προσδιοριστεί από την τιμή ενός αριθμού πάνω στην πραγματική ευθεία.


                                                                 .md ### Κανονική κατανομή

Κανονική κατανομή


                                                                 .md Ας υποθέσουμε ότι έχουμε δύο πληθυσμούς `pop1` και `pop2`, τους οποίους εξαιτάζουμε ως προς τη θέση στο πολιτικό φάσμα. Κάτωθι δίνεται η κατανομή του φρονήματος του ενός και του άλλου, όπου στην παρούσα ενότητα έχουν υποτεθεί κανονικές. Δεχόμαστε επίσης ότι ο αριθμός των γεννήσεων είναι μηδενικός.

Πρώτη δίνεται η κατανομή του `pop1`.

Ας υποθέσουμε ότι έχουμε δύο πληθυσμούς `pop1` και `pop2`, τους οποίους εξαιτάζουμε ως προς τη θέση στο πολιτικό φάσμα. Κάτωθι δίνεται η κατανομή του φρονήματος του ενός και του άλλου, όπου στην παρούσα ενότητα έχουν υποτεθεί κανονικές. Πρώτη δίνεται η κατανομή του `pop1`.


                                                                   Clear["Global`*"]
m1=0;
s1=3;
m2=5;
s2=1;
a = Min[m1-3s1,m2-3s2];
b= Max[m1+3s1,m2+3s2];
pop1[x_]:=PDF[NormalDistribution[m1,s1],x]
pop2[x_]:=PDF[NormalDistribution[m2,s2],x]
Plot[pop1[x],{x,a,b},PlotRange->All]


                                                                   .md Ακολουθεί η κατανομή του `pop2`.

Ακολουθεί η κατανομή του `pop2`.


                                                                    Plot[pop2[x],{x,a,b},PlotRange->All]


                                                                    .md Ακολούθως τους αναμειγνύουμε και φτιάχνουμε έναν ενιαίο πληθυσμό `pop`. Στο σημείο αυτό θα πρέπει να επισημάνουμε ότι δεν είναι ίδιοι οι `pop1` και `pop2`. Συγκεκριμένα, ο `pop1` είναι το `p1=90%` ποσοστό του `pop` και ο `pop2` το `p2=1-p1=10%` ποσοστό του `pop`. Έχουμε, λοιπόν, την κάτωθι κατανομή.

Ακολούθως τους αναμειγνύουμε και φτιάχνουμε έναν ενιαίο πληθυσμό `pop`. Στο σημείο αυτό θα πρέπει να επισημάνουμε ότι δεν είναι ίδιοι οι `pop1` και `pop2`. Συγκεκριμένα, ο `pop1` είναι το `p1=90%` ποσοστό του `pop` και ο `pop2` το `p2=1-p1=10%` ποσοστό του `pop`. Έχουμε, λοιπόν, την κάτωθι κατανομή.


                                                                     p1 = 0.9;
p2 = 1-p1;
pop[x_]:=p1 pop1[x]+p2 pop2[x]
Plot[pop[x],{x,a,b},PlotRange->All]


                                                                     .md Με βάση αυτές τις υποθέσεις μπορούμε να λύσουμε την:

$$
u_t+ku_{xx}=0
$$

Για λόγους υπολογιστικής ευκολίας ετέθη $k=\frac{1}{100}$. Τοιαύτη περιπτώσει η $u(x,t)$ είναι η:

Με βάση αυτές τις υποθέσεις μπορούμε να λύσουμε την: $$ u_t+ku_{xx}=0 $$ Για λόγους υπολογιστικής ευκολίας ετέθη $k=\frac{1}{100}$. Τοιαύτη περιπτώσει η $u(x,t)$ είναι η:


                                                                          k=1/100;
sol = DSolve[
    {D[u[x,t], t] == -k D[u[x,t], {x, 2}], 
     u[x,0] == pop[x]}, 
    u[x,t], {x,t}];
u[x_,t_]:=Evaluate[u[x,t] /. sol];
u[x,t]


                                                                          .md Μπορούμε να επαληθεύσουμε ότι αυτό που βρήκαμε αποτελεί μια κατανομή, επιλέγοντας κάποιες τυχαίες χρονικές στιγμές $t_0$ και υπολογίζοντας το ολοκλήρωμα:

$$
\int_{-\infty}^{+\infty} u(x,t_0)dx
$$

Μπορούμε να επαληθεύσουμε ότι αυτό που βρήκαμε αποτελεί μια κατανομή, επιλέγοντας κάποιες τυχαίες χρονικές στιγμές $t_0$ και υπολογίζοντας το ολοκλήρωμα: $$ \int_{-\infty}^{+\infty} u(x,t_0)dx $$


                                                                              tableInt = Table[{t,NIntegrate[u[x,t],{x,a-10,b+10}]},{t,0,10,0.5}];
TableForm[tableInt, TableHeadings -> {None,{"t","Integral"}}]


                                                                              .md Βλέπουμε πως κάθε ολοκλήρωμα που υπολογίσαμε είναι περίπου $1$, όπως όφειλε. Ο λόγος που δεν είναι ακριβώς $1$ είναι επειδή, για λόγους ταχύτητας, δεν υπολογίσαμε το ακριβές ολοκλήρωμα, αλλά μια αριθμητική του προσέγγιση.

Ας πάμε τώρα να εξετάσουμε οπτικά την εξέλιξη του πολιτικού φάσματος.

Βλέπουμε πως κάθε ολοκλήρωμα που υπολογίσαμε είναι περίπου $1$, όπως όφειλε. Ο λόγος που δεν είναι ακριβώς $1$ είναι επειδή, για λόγους ταχύτητας, δεν υπολογίσαμε το ακριβές ολοκλήρωμα, αλλά μια αριθμητική του προσέγγιση.


                                                                               numOfa = 15;
aMax=50;
colList = Table[ColorData["SunsetColors"][n], {n, 0, 1, 1/numOfa}];

nameList = 
  Table["t=" <> ToString[N[n]], {n, 0, aMax, (aMax)/numOfa}];
fList1 = 
  Table[u[x,t], {t, 0, aMax, (aMax)/numOfa}];
  p1 = Plot[fList1, {x, m1-3s1, m2+3s2}, 
   PlotStyle -> colList, ImageSize -> Medium, 
   PlotLegends -> nameList, 
   PlotLabel -> 
    "Χρονική εξέλιξη δύο κανονικών πληθυσμών", Background -> Gray]


                                                                               .md Ένα ενδεικτικό αποτέλεσμα είναι το εικονιζόμενο, όπου ο ένας πληθυσμός, αυτός με τη στενότερη τυπική απόκλιση, γίνεται σε πεπερασμένο χρονικό διάστημα μονολιθικός, δηλαδή όλος ο πληθυσμός έχει π.χ. την ίδια πολιτική απόχρωση.

Ένα ενδεικτικό αποτέλεσμα είναι το εικονιζόμενο, όπου ο ένας πληθυσμός, αυτός με τη στενότερη τυπική απόκλιση, γίνεται σε πεπερασμένο χρονικό διάστημα μονολιθικός, δηλαδή όλος ο πληθυσμός έχει π.χ. την ίδια πολιτική απόχρωση.


                                                                                .md ### Κατανομή Χι-τετράγωνο - ανάγκη βελτίωσης μοντέλου

Αυτή τη φορά θα θεωρήσουμε ότι το πολιτικό φάσμα ακολουθεί την κατανομή $\chi^2$. Εδώ θα βάλουμε παράμετρο $\nu=3$ και πάλι θα θεωρήσουμε ότι η ροή ο ρυθμός γεννήσεων είναι και πάλι μηδέν.

Κατανομή Χι-τετράγωνο - ανάγκη βελτίωσης μοντέλου

Αυτή τη φορά θα θεωρήσουμε ότι το πολιτικό φάσμα ακολουθεί την κατανομή $\chi^2$. Εδώ θα βάλουμε παράμετρο $\nu=3$ και πάλι θα θεωρήσουμε ότι η ροή ο ρυθμός γεννήσεων είναι και πάλι μηδέν.


                                                                                 Clear["Global`*"]
n = 3;
a = 10;
pop[x_] := PDF[ChiSquareDistribution[n], x]
Plot[pop[x],{x,0,a}]


                                                                                 .md Λόγω της αλγεβρικής δυσκολίας της $\chi^2$ επιχειρούμε εν προκειμένω αριθμητική επίλυση της Μ.Δ.Ε., θεωρώντας και πάλι $k=\frac{1}{100}$. Επαληθεύουμε τη λύση μας, για να δούμε αν βρήκαμε κατανομή και όντως φαίνεται κάτι τέτοιο.

Λόγω της αλγεβρικής δυσκολίας της $\chi^2$ επιχειρούμε εν προκειμένω αριθμητική επίλυση της Μ.Δ.Ε., θεωρώντας και πάλι $k=\frac{1}{100}$. Επαληθεύουμε τη λύση μας, για να δούμε αν βρήκαμε κατανομή και όντως φαίνεται κάτι τέτοιο.


                                                                                  k=1/100;
sol = NDSolve[
    {D[u[x,t], t] == -k D[u[x,t], {x, 2}], 
     u[x,0] == pop[x]}, 
    u[x,t], {x,0,10},{t,0,50}];
u[x_,t_]:=Evaluate[u[x,t] /. sol];
tableInt = Table[{t,NIntegrate[u[x,t],{x,0,a+10}]},{t,0,10,0.5}];
TableForm[tableInt, TableHeadings -> {None,{"t","Integral"}}]


                                                                                  .md Εξετάζοντας σε βάθος χρόνου  τα αποτελέσματα που βρήκαμε, διαπιστώνουμε ότι και πάλι ο πληθυσμός τείνει να διαμεριστεί σε κάποιους επιμέρους μονοληθικούς πληθυσμούς.

Εξετάζοντας σε βάθος χρόνου τα αποτελέσματα που βρήκαμε, διαπιστώνουμε ότι και πάλι ο πληθυσμός τείνει να διαμεριστεί σε κάποιους επιμέρους μονοληθικούς πληθυσμούς.


                                                                                   numOfa = 15;
aMax=20;
colList = Table[ColorData["SunsetColors"][n], {n, 0, 1, 1/numOfa}];

nameList = 
  Table["t=" <> ToString[N[n]], {n, 0, aMax, (aMax)/numOfa}];
fList1 = 
  Table[u[x,t], {t, 0, aMax, (aMax)/numOfa}];
  p1 = Plot[fList1, {x, 0,a}, 
   PlotStyle -> colList, ImageSize -> Medium, 
   PlotLegends -> nameList, 
   PlotLabel -> 
    "Χρονική εξέλιξη δύο πληθυσμών με κατανομή τη Χ^2", Background -> Gray]


                                                                                   .md Φαίνεται νδιαφέρον το αποτέλεσμα, αλλά εδώ αρχίζουν τ παράδοξα που θέτουν εν αμφιβόλω το μοντέλο μας. Επιχειρώντας να δούμε την κατανομή μετά από μεγάλο χρονικό διάστημα, βλέπουμε κάτι τέτοιο.

Φαίνεται νδιαφέρον το αποτέλεσμα, αλλά εδώ αρχίζουν τ παράδοξα που θέτουν εν αμφιβόλω το μοντέλο μας. Επιχειρώντας να δούμε την κατανομή μετά από μεγάλο χρονικό διάστημα, βλέπουμε κάτι τέτοιο.


                                                                                    t0 = 50;
Plot[u[x,t0], {x, 0,a}, PlotLabel -> "t="<>ToString[t0], Background -> Gray,PlotRange -> All]


                                                                                    .md Προφανώς, τελικά δεν μπορούμε να μιλάμε για κατανομή, τη στιγμή που παίρνει αρνητικές τιμές. Το δίχως άλλο, φταίει το μοντέλο μας. Ίσως να πρέπει να το ενισχύσουμε με τρόπο που να λαμβάνει υπ' όψιν το γεγονός ότι κάποιες τιμές είναι εξαιρετικά απίθανες, ώστε να μην πετάγονται στα αρνητικά. Προς τούτο μπορούμε να τροποποιήσουμε τη συνθήκη:

$$
\boldsymbol{\phi}= k \nabla u,
$$

ως:

$$
\boldsymbol{\phi}= k u \nabla u,
$$

ούτως ώστε για μικρές τιμές του $u$ να έχουμε μικρή ροή. Τοιαύτη περιπτώσει η μερική διαφορική εξίσωση:

$$
u_t+\nabla\cdot\boldsymbol{\phi}=r(u).
$$

μάς οδηγεί στη σχέση:

$$
u_t+\nabla\cdot\left(k u \nabla u\right)=r(u)\Leftrightarrow u_t+k\left(\nabla u\right)^2+k u\nabla^2 u=r(u)
$$

αντί της:

$$
u_t+k\nabla^2 u =r(u),
$$

που είχαμε αρχικά. Θεωρώντας το πολιτικό φάσμα να εκτείνεται σε μία αριθμογραμμή, έχουμε:

$$
u_t+k(u_x)^2+k u u_{xx}=r(u).
$$

Ας ξεκινήσουμε πάλι με την κατανομή $\chi^2$.

Προφανώς, τελικά δεν μπορούμε να μιλάμε για κατανομή, τη στιγμή που παίρνει αρνητικές τιμές. Το δίχως άλλο, φταίει το μοντέλο μας. Ίσως να πρέπει να το ενισχύσουμε με τρόπο που να λαμβάνει υπ' όψιν το γεγονός ότι κάποιες τιμές είναι εξαιρετικά απίθανες, ώστε να μην πετάγονται στα αρνητικά. Προς τούτο μπορούμε να τροποποιήσουμε τη συνθήκη: $$ \boldsymbol{\phi}= k \nabla u, $$ ως: $$ \boldsymbol{\phi}= k u \nabla u, $$ ούτως ώστε για μικρές τιμές του $u$ να έχουμε μικρή ροή. Τοιαύτη περιπτώσει η μερική διαφορική εξίσωση: $$ u_t+\nabla\cdot\boldsymbol{\phi}=r(u). $$ μάς οδηγεί στη σχέση: $$ u_t+\nabla\cdot\left(k u \nabla u\right)=r(u)\Leftrightarrow u_t+k\left(\nabla u\right)^2+k u\nabla^2 u=r(u) $$ αντί της: $$ u_t+k\nabla^2 u =r(u), $$ που είχαμε αρχικά. Θεωρώντας το πολιτικό φάσμα να εκτείνεται σε μία αριθμογραμμή, έχουμε: $$ u_t+k(u_x)^2+k u u_{xx}=r(u). $$ Ας ξεκινήσουμε πάλι με την κατανομή $\chi^2$.


                                                                                                             Clear["Global`*"]
n = 3;
a = 10;
pop[x_] := PDF[ChiSquareDistribution[n], x]
Plot[pop[x],{x,0,a}]


                                                                                                             .md Ελέγχουμε και πάλι το ολοκλήρωμα αν βγαίνει $1$ και βλέπουμε ότι σχεδόν σε όλες τις τιμές υπάρχει μια καλή προσέγγιση. Από κάποια χρονική στιγμή και μετά αρχίζει και χαλάει το πράγμα, το οποίο ίσως και να οφείλεται στο ότι αυτή τη φορά επιλέξαμε αριθμητική επίλυση της Μ.Δ.Ε. κι όχι ακριβή.

Ελέγχουμε και πάλι το ολοκλήρωμα αν βγαίνει $1$ και βλέπουμε ότι σχεδόν σε όλες τις τιμές υπάρχει μια καλή προσέγγιση. Από κάποια χρονική στιγμή και μετά αρχίζει και χαλάει το πράγμα, το οποίο ίσως και να οφείλεται στο ότι αυτή τη φορά επιλέξαμε αριθμητική επίλυση της Μ.Δ.Ε. κι όχι ακριβή.


                                                                                                              k=1/100;
eq = D[u[x,t], t] + k u[x,t]* D[u[x,t], {x, 2}] + k (D[u[x,t], x])^2==0;
sol = NDSolve[
    {eq, 
     u[x,0] == pop[x]}, 
    u[x,t], {x,0,10},{t,0,50}];
u[x_,t_]:=Evaluate[u[x,t] /. sol];
tableInt = Table[{t,NIntegrate[u[x,t],{x,0,a+10}]},{t,0,10,0.5}];
TableForm[tableInt, TableHeadings -> {None,{"t","Integral"}}]


                                                                                                              .md Οπτικοποιώντας την εξέλιξη της κατανομής βλέπουμε και επιπλέον παράδοξο, την ύπαρξη αρνητικών τιμών. Τοιαύτη περιπτώσει έχουμε το δικαίωμα να υποθέσουμε ότι αυτό οφείλεται σε σφάλαματα της αριθμητικής προσέγγισης, ως εναλλακτική ερμηνεία του να δεχτούμε ότι είναι ένα δομικό πρόβλημα του μοντέλου μας. Σε αυτό φαίνεται να συνηγορεί και το γεγονός ότι έχουμε τα προβλήματα κοντά στο $x=0$, εκεί δηλαδή που απειρίζεται η κλίση της $\chi^2$.

Οπτικοποιώντας την εξέλιξη της κατανομής βλέπουμε και επιπλέον παράδοξο, την ύπαρξη αρνητικών τιμών. Τοιαύτη περιπτώσει έχουμε το δικαίωμα να υποθέσουμε ότι αυτό οφείλεται σε σφάλαματα της αριθμητικής προσέγγισης, ως εναλλακτική ερμηνεία του να δεχτούμε ότι είναι ένα δομικό πρόβλημα του μοντέλου μας. Σε αυτό φαίνεται να συνηγορεί και το γεγονός ότι έχουμε τα προβλήματα κοντά στο $x=0$, εκεί δηλαδή που απειρίζεται η κλίση της $\chi^2$.


                                                                                                               numOfa = 25;
aMax=12;
colList = Table[ColorData["SunsetColors"][n], {n, 0, 1, 1/numOfa}];

nameList = 
  Table["t=" <> ToString[N[n]], {n, 0, aMax, (aMax)/numOfa}];
fList1 = 
  Table[u[x,t], {t, 0, aMax, (aMax)/numOfa}];
  p1 = Plot[fList1, {x, 0,a}, 
   PlotStyle -> colList, ImageSize -> Medium, 
   PlotLegends -> nameList, 
   PlotLabel -> 
    "Χρονική εξέλιξη δύο πληθυσμών με κατανομή τη Χ^2", Background -> Gray]


                                                                                                               t0 = 30;
Plot[u[x,t0], {x, 0,a}, PlotLabel -> "t="<>ToString[t0], Background -> Gray,PlotRange -> All]


                                                                                                               .md ## Ταξίδι στο παρελθόν;

Είδαμε στις προηγούμενες ενότητες ότι ξεκινώντας από κάποια κατανομή του πολιτικού φάσματος, καταλήγουμε σε κάποιους μονοληθικούς πληθησμούς. Τι θα συνέβαινε αν ξεκινούσαμε από κάποιους μονοληθικούς πληθυσμούς; Δηλαδή, τι θα συμβεί αν αυτοί ακολουθούν την κατανομή το Δέλτα του Dirac; Η απάντηση ενδεικτικά είναι η κάτωθι:

Ταξίδι στο παρελθόν;

Είδαμε στις προηγούμενες ενότητες ότι ξεκινώντας από κάποια κατανομή του πολιτικού φάσματος, καταλήγουμε σε κάποιους μονοληθικούς πληθησμούς. Τι θα συνέβαινε αν ξεκινούσαμε από κάποιους μονοληθικούς πληθυσμούς; Δηλαδή, τι θα συμβεί αν αυτοί ακολουθούν την κατανομή το Δέλτα του Dirac; Η απάντηση ενδεικτικά είναι η κάτωθι:


                                                                                                                Clear["Global`*"]
k=1/100;
p1=99/100;
p2=1-p1;
m1=0;
s1=15/10;
m2=5;
s2=1;
sol = DSolve[
    {D[u[x,t], t] == -k D[u[x,t], {x, 2}], 
     u[x,0] == p1 DiracDelta[x-m1]+p2 DiracDelta[x-m2]}, 
    u[x,t], {x,t}];
u[x_,t_]:=Evaluate[u[x,t] /. sol];
u[x,t]


                                                                                                                .md Δεδομένου ότι η παραπάνω συνάρτηση ορίζεται για $t\leq 0$, θα μπορούσαμε να πούμε ότι η εν λόγω λύση δίνει το παρελθόν της ανάμειξης αυτών των πληθυσμών. Ας το δούμε και οπτικά:

Δεδομένου ότι η παραπάνω συνάρτηση ορίζεται για $t\leq 0$, θα μπορούσαμε να πούμε ότι η εν λόγω λύση δίνει το παρελθόν της ανάμειξης αυτών των πληθυσμών. Ας το δούμε και οπτικά:


                                                                                                                 t0 = -40;
Plot[u[x,t0], {x, m1-3s1, m2+3s2}, PlotLabel -> "t="<>ToString[t0], Background -> Gray,PlotRange -> All]


                                                                                                                 .md Την πορεία προς τα πίσω την βλέπουμε ευκρινέστερα με το κάτωθι γράφημα.

Την πορεία προς τα πίσω την βλέπουμε ευκρινέστερα με το κάτωθι γράφημα.


                                                                                                                  numOfa = 15;
aMax=20;
colList = Table[ColorData["SunsetColors"][n], {n, 0, 1, 1/numOfa}];

nameList = 
  Table["t=" <> ToString[N[n]], {n, -aMax,0, (aMax)/numOfa}];
fList1 = 
  Table[u[x,t], {t,-aMax,0, (aMax)/numOfa}];
p1 = Plot[fList1, {x, m1-3s1, m2+3s2},    PlotStyle -> colList, ImageSize -> Medium, 
   PlotLegends -> nameList, PlotLabel -> "Χρονική εξέλιξη δύο πληθυσμών με κατανομή τη δέλτα του Dirac", Background -> Gray]